'{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
'    C O N T E S T - D U P E  &  S A V E    P R O G R A M
'          by Bj. Madsen - VE5FX      Nov. 11, 1986
'}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}

' This program will allow input of callsigns for contest duping purposes.
' The callsigns will be 'duped' for match.  The program also checks
' for valid callsigns, requiring both numbers and letters and allowing
' for the inclusion of a slash.   A NEW prefix will provide
' a choice of whether to save or pass.  Callsigns will be saved to a
' pre-defined disk file every 20 entries or whenever the command <SAVE>
' is entered in place of a callsign.  At the end of the session, enter
' the word <END>.  Outstanding calls will be saved and the program will end.

 CLEAR 1000
 CLEAR ,100000
 DEFINT K-Z
 
  DIM M$(21) : DIM Z$(21) : DIM TPX$(21) :DIM PX$(2000)
  DIM A$(400):DIM b$(400): DIM C$(500): DIM D$(500): DIM E$(400)
  DIM F$(400): DIM G$(400): DIM H$(400): DIM I$(400): DIM J$(400) 
   CLS:WINDOW 1, "WPX CONTEST DUPING PROGRAM ",(0,0)-(610,185),15
   
  TITLE: '----------------------------------------------------Title for menu
    LINE (0,0)-(640,5),3,bf
    LINE (0,0)-(10,200),3,bf
    LINE (607,0)-(617,200),3,bf
    LINE (0,181)-(617,186),3,bf
    LINE (0,30)-(640,35),3,b
    PAINT (20,10),2,3
    PAINT (20,33),1,3
    COLOR 3,2
    LOCATE 3,25:PRINT " VE5FX  -*-  CONTEST DUPER "
    COLOR 2,3 :PRINT :PRINT 

    PRINT :PRINT :PRINT TAB(10)"  To save fewer than 20 calls to disk, enter the word <SAVE>  "
    PRINT TAB(22)"  rather than the regular callsign..... "
    PRINT:PRINT TAB(15)">>>>> shift NOW to UPPER CASE LETTERS <<<<<"
   
    COLOR 1,0
    PRINT :PRINT :PRINT TAB(15)"Are there calls to be entered from a disk file";:INPUT A$
       IF LEFT$(A$,1) = "Y" THEN GOTO LOAD.CALLS
'Create a file on disk
    PRINT :PRINT :PRINT  TAB(15)"What filename do you wish to use";:INPUT DUPEFILE$
     PRINT :COLOR 2,3:PRINT TAB(15)"Creating output file named: ";DUPEFILE$ :COLOR 1,0
      OPEN DUPEFILE$ FOR OUTPUT AS #1 
      CLOSE #1
'Set up input windows
SET.WINDOW:
   CLS
    WINDOW 1,"BASIC WINDOW",(120,15)-(400,170),15
    WINDOW 2,"Contest Listing for VE5FX ",(1,1)-(610,10),2

DATA.ENTRY:                                 'Get callsign for entry
      WINDOW OUTPUT 2 : COLOR 1,2: CLS
      INPUT"What is the callsign.....";CS$
      IF CS$ = "SAVE" OR CS$ = "END" THEN GOSUB  SAVE.TO.DISK: GOTO DATA.ENTRY
      
'Check callsign for validity
    N=0 : P=0 : L=0
    FOR V=1 TO LEN(CS$)
      X$ = MID$(CS$,V,1)
        IF X$<"/" OR X$>"9" AND X$<"A" OR X$>"Z" THEN N=N+1
         IF X$>"/" AND X$<":" THEN P=V
        IF X$>"@" AND X$<"[" THEN L=V
     NEXT V   
        IF (N>0) OR (P=0) OR (L=0) THEN GOTO FLASH
     ON VAL(MID$(CS$,P,1)) GOTO ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE  
     IF VAL(MID$(CS$,P,1))=0 THEN ZERO
     
FLASH:               'Data entry error message for invalid callsigns
  WINDOW OUTPUT 2: COLOR 1,2
    FOR V = 1 TO 10
     BEEP
     PRINT TAB(10)">>>>> I N V A L I D    C A L L S I G N <<<<<"
    NEXT V
  GOTO DATA.ENTRY 
  
ONE:
  FOR X=1 TO A
    IF A$(X) = CS$ THEN K$=A$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN A=A+1: A$(A)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,A$(A),A
  GOTO DATA.ENTRY
  
TWO:
    FOR X=1 TO b
    IF b$(X) = CS$ THEN K$=b$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN b=b+1: b$(b)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,b$(b),b
  GOTO DATA.ENTRY
   
THREE:
  FOR X=1 TO C
    IF C$(X) = CS$ THEN K$=C$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN C=C+1: C$(C)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,C$(C),C
  GOTO DATA.ENTRY

FOUR:
  FOR X=1 TO D
    IF D$(X) = CS$ THEN K$=D$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN D=D+1: D$(D)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,D$(D),D
  GOTO DATA.ENTRY

FIVE:
  FOR X=1 TO E
    IF E$(X) = CS$ THEN K$=E$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN E=E+1: E$(E)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,E$(E),E
  GOTO DATA.ENTRY

SIX:
  FOR X=1 TO F
    IF F$(X) = CS$ THEN K$=F$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN F=F+1: F$(F)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,F$(F),F
  GOTO DATA.ENTRY

SEVEN:
  FOR X=1 TO G
    IF G$(X) = CS$ THEN K$=G$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN G=G+1: G$(G)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,G$(G),G
  GOTO DATA.ENTRY
 
EIGHT: 
  FOR X=1 TO H
    IF H$(X) = CS$ THEN K$=H$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN H=H+1: H$(H)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,H$(H),H
  GOTO DATA.ENTRY

NINE:
  FOR X=1 TO I
    IF I$(X) = CS$ THEN K$=I$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN I=I+1: I$(I)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,I$(I),I
  GOTO DATA.ENTRY
 
ZERO:
  FOR X=1 TO J
    IF J$(X) = CS$ THEN K$=J$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB SAVE.CALL
    IF C$="S" THEN J=J+1: J$(J)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,J$(J),J
  GOTO DATA.ENTRY
   
DUPE.TELL:
   WINDOW OUTPUT 2: COLOR 2,1
   FOR V=1 TO 10: BEEP
     PRINT TAB(10) "  DUPE ==> ";K$;" is already on file.....  "
   NEXT V: GOTO DATA.ENTRY 
   
SAVE.CALL:
   WINDOW OUTPUT 2: COLOR 2,1
     PRINT TAB(10)"  " CS$;" is a new call...<S>ave or <P>ass?  ";
    LOOP:
     C$=INKEY$
       IF C$ = "S" THEN M=M+1: M$(M)=CS$
       IF M = 20 THEN GOSUB SAVE.TO.DISK: RETURN
       IF C$ = "S" THEN RETURN
       IF C$ = "P" THEN RETURN
     GOTO LOOP
     
SAVE.TO.DISK:               'save 20 calls or fewer to disk file
  WINDOW OUTPUT 1: COLOR 3,0
  PRINT "Saving ";M;" calls to file: ";DUPEFILE$
    OPEN "A",#1, DUPEFILE$
      FOR V=1 TO M
         PRINT #1, M$(V)
      NEXT V
    CLOSE #1: M=0 : COLOR 1,0
   IF CS$ = "END" THEN END :ELSE RETURN
    
    
LOAD.CALLS:            'load previously created file from disk
  CLS:PRINT :PRINT :INPUT"What filename do you wish to load";DUPEFILE$
  OPEN "I",#1,DUPEFILE$
   WHILE NOT EOF(1)
    INPUT #1, CS$
      FOR V=1 TO LEN(CS$)
        X$=MID$(CS$,V,1)
        IF X$>"/" AND X$<":" THEN N=VAL(X$)    'N is value of last number
      NEXT V
    
      ON N GOTO WON,TOO,THR,FER,FIV,SEX,SEV,ATE,NIN
      IF N = 0 THEN DIX
    WON:  A=A+1: A$(A)=CS$: GOTO LAST
    TOO:  b=b+1: b$(b)=CS$: GOTO LAST
    THR:  C=C+1: C$(C)=CS$: GOTO LAST
    FER:  D=D+1: D$(D)=CS$: GOTO LAST 
    FIV:  E=E+1: E$(E)=CS$: GOTO LAST
    SEX:  F=F+1: F$(F)=CS$: GOTO LAST
    SEV:  G=G+1: G$(G)=CS$: GOTO LAST
    ATE:  H=H+1: H$(H)=CS$: GOTO LAST
    NIN:  I=I+1: I$(I)=CS$: GOTO LAST
    DIX:  J=J+1: J$(J)=CS$: GOTO LAST
    LAST:
  WEND
   CLOSE #1: COLOR 2,3: PRINT :PRINT :PRINT 
   PRINT "     A total of ";A+b+C+D+E+F+G+H+I+J;" callsigns on file     "
   COLOR 3,0:PRINT :PRINT 
   INPUT"Press <RETURN> to continue.....";C$
  GOTO SET.WINDOW